home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / HyperCard / USING APPS AS XCMDs / XXCMD.p < prev   
Text File  |  1990-06-30  |  9KB  |  353 lines
  1. {
  2. XXCMD - an XCMD for running external XCMDs
  3.  
  4. by brad pickering
  5. }
  6.  
  7. {$r-}
  8.  
  9. UNIT dummy;
  10.  
  11.   INTERFACE
  12.  
  13.     USES MemTypes, Quickdraw, OSIntf, ToolIntf, HyperXCmd, HyperXXCmd;
  14.  
  15.     PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  16.  
  17.   IMPLEMENTATION
  18.  
  19.     PROCEDURE XXCMD(paramPtr: XCmdPtr);
  20.  
  21.       FORWARD;
  22.  
  23.     PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  24.  
  25.     { The EntryPoint must be the first piece of code in the XCMD. It
  26.       simply calls the routine that does the main processing.
  27.     }
  28.  
  29.       BEGIN
  30.         XXCMD(paramPtr);
  31.       END;
  32.  
  33.     PROCEDURE Execute(a5, pc: longint);
  34.  
  35.     { Execute the XXCMD given its global pointer and program counter.
  36.         move.l  (sp)+,a0    ; pc
  37.         move.l  (sp)+,a1    ; a5
  38.         movem.l a2-a5/d2-d7,-(sp)
  39.         move.l  a1,a5
  40.         jsr (a0)
  41.         movem.l (sp)+,a2-a5/d2-d7
  42.     }
  43.  
  44.       INLINE $205F, $225F, $48E7, $3F3C, $2A49, $4E90, $4CDF, $3CFC;
  45.  
  46.     PROCEDURE XXCMD(paramPtr: XCmdPtr);
  47.  
  48.       TYPE
  49.         JTEntry = RECORD
  50.           rOff, opcode: integer;
  51.           value: longint;
  52.           END;
  53.         JTPtr = ^JTEntry;
  54.  
  55.       VAR
  56.         h: Handle;
  57.         xname, jtname, tstr: Str255;
  58.         jt: JTPtr;
  59.         xdata: XXCmdHandle;
  60.         xp: XXCmdHandlePtr;
  61.  
  62.       PROCEDURE LoadXXCMD;
  63.  
  64.         CONST
  65.           maxRes = 25;
  66.  
  67.         VAR
  68.           h: Handle;
  69.           i: integer;
  70.           seg: ARRAY [1..maxRes] OF Ptr;
  71.           xdata: XXCmdHandle;
  72.           xp: XXCmdHandlePtr;
  73.  
  74.         PROCEDURE LoadSegs;
  75.  
  76.           VAR
  77.             xfile, i: integer;
  78.  
  79.           PROCEDURE LoadErr(msg: Str255);
  80.  
  81.             VAR
  82.               i: integer;
  83.               h: Handle;
  84.  
  85.             BEGIN
  86.  
  87.               { Clean up and exit. }
  88.  
  89.               CloseResFile(xfile);
  90.               FOR i := 1 TO maxRes DO
  91.                 IF seg[i] <> NIL THEN BEGIN
  92.                   h := RecoverHandle(seg[i]);
  93.                   DisposHandle(h);
  94.                 END;
  95.               paramPtr^.returnValue := PasToZero(paramPtr, msg);
  96.               exit(XXCMD);
  97.             END;
  98.  
  99.           PROCEDURE OpenXXCMD;
  100.  
  101.             VAR
  102.               fcb: FCBPBRec;
  103.               status: OSErr;
  104.               h: Handle;
  105.               apname: Str255;
  106.  
  107.             BEGIN
  108.  
  109.               { Try opening the resource file in the same directory as the current stack. }
  110.  
  111.               fcb.ioCompletion := NIL;
  112.               fcb.ioNamePtr := NIL;
  113.               fcb.ioVRefNum := 0;
  114.               fcb.ioRefNum := CurResFile;
  115.               fcb.ioFCBIndx := 0;
  116.               status := PBGetFCBInfo(@fcb, false);
  117.               IF status = noErr THEN
  118.                 xfile := HOpenResFile(fcb.ioFCBVRefNum, fcb.ioFCBParID, xname, fsRdPerm);
  119.               IF (status <> noErr) OR (ResError <> noErr) THEN BEGIN
  120.  
  121.                 { Try opening the resource file in the same directory as HyperCard. }
  122.  
  123.                 fcb.ioCompletion := NIL;
  124.                 fcb.ioNamePtr := NIL;
  125.                 fcb.ioVRefNum := 0;
  126.                 GetAppParms(apname, fcb.ioRefNum, h);
  127.                 fcb.ioFCBIndx := 0;
  128.                 status := PBGetFCBInfo(@fcb, false);
  129.                 IF status = noErr THEN
  130.                   xfile := HOpenResFile(fcb.ioFCBVRefNum, fcb.ioFCBParID, xname, fsRdPerm);
  131.                 IF (status <> noErr) OR (ResError <> noErr) THEN BEGIN
  132.  
  133.                   { Try opening the resource file in the System Folder (PMSP). }
  134.  
  135.                   xfile := OpenRFPerm(xname, 0, fsRdPerm);
  136.                   IF ResError <> noErr THEN BEGIN
  137.                     paramPtr^.returnValue := PasToZero(paramPtr, concat('ERROR: can''t open resource file ', xname, '.'));
  138.                     exit(XXCMD);
  139.                   END;
  140.  
  141.                 END;
  142.               END;
  143.             END;
  144.  
  145.           PROCEDURE ReadXXCMD;
  146.  
  147.             TYPE
  148.               CodeHead = RECORD
  149.                 above, below, jtlen, jtoff: longint;
  150.                 END;
  151.  
  152.             VAR
  153.               i, id: integer;
  154.               h: Handle;
  155.               rname: Str255;
  156.               rtype: ResType;
  157.               p: longint;
  158.               code: CodeHead;
  159.  
  160.             BEGIN
  161.  
  162.               { Load each code segment. }
  163.  
  164.               FOR i := 1 TO Count1Resources('CODE') DO BEGIN
  165.  
  166.                 { Load it. }
  167.  
  168.                 h := Get1IndResource('CODE', i);
  169.                 IF ResError <> noErr THEN
  170.                   LoadErr('ERROR: can''t read code resource.');
  171.  
  172.                 { Check that the resource id is not too high. }
  173.  
  174.                 GetResInfo(h, id, rtype, rname);
  175.                 IF id > maxRes THEN
  176.                   LoadErr('ERROR: code resource number is too high.');
  177.  
  178.                 { Check whether this is the jump table segment or a regular segment. }
  179.  
  180.                 IF id = 0 THEN BEGIN
  181.  
  182.                   { Allocate and fill the jump table. }
  183.  
  184.                   BlockMove(h^, Ptr(@code), sizeof(CodeHead));
  185.                   Ptr(p) := NewPtr(code.above + code.below);
  186.                   IF MemError <> noErr THEN
  187.                     LoadErr('ERROR: out of memory.');
  188.                   jt := JTPtr(p + code.below + code.jtoff);
  189.                   BlockMove(Ptr(longint(h^) + sizeof(CodeHead)), Ptr(jt), code.jtlen);
  190.                   ReleaseResource(h);
  191.  
  192.                 END
  193.                 ELSE BEGIN
  194.  
  195.                   { Free the segment and lock it down. }
  196.  
  197.                   DetachResource(h);
  198.                   MoveHHi(h);
  199.                   HLock(h);
  200.                   seg[id] := h^;
  201.  
  202.                 END;
  203.               END;
  204.             END;
  205.  
  206.           BEGIN
  207.  
  208.             { Initialize the data. }
  209.  
  210.             jt := NIL;
  211.             FOR i := 1 TO maxRes DO
  212.               seg[i] := NIL;
  213.  
  214.             { Open the XXCMD and Read in the code segments. }
  215.  
  216.             OpenXXCMD;
  217.             ReadXXCMD;
  218.  
  219.             { Check that the resource file was in application format then clean up. }
  220.  
  221.             IF jt = NIL THEN
  222.               LoadErr('ERROR: can''t find code resource 0.');
  223.             CloseResFile(xfile);
  224.  
  225.           END;
  226.  
  227.         PROCEDURE FixJT;
  228.  
  229.           TYPE
  230.             SegHead = RECORD
  231.               firstOff, eCount: integer;
  232.               END;
  233.             SegHeadPtr = ^SegHead;
  234.  
  235.           VAR
  236.             i, j: integer;
  237.             sHead: SegHeadPtr;
  238.             jtp: JTPtr;
  239.  
  240.           PROCEDURE MakeLoaded(VAR jTE: JTEntry; seg: Ptr);
  241.  
  242.             CONST
  243.               jmp = $4EF9;
  244.  
  245.             BEGIN
  246.  
  247.               { Setup the jump table entry with the instruction to jump to the correct routine. }
  248.  
  249.               WITH jTE DO BEGIN
  250.                 opcode := jmp;
  251.                 value := longint(seg) + sizeof(SegHead) + longint(rOff);
  252.               END;
  253.  
  254.             END;
  255.  
  256.           BEGIN
  257.  
  258.             { Setup the jump table entries for each routine for each segment. }
  259.  
  260.             FOR i := 1 TO maxRes DO
  261.               IF seg[i] <> NIL THEN BEGIN
  262.                 sHead := SegHeadPtr(seg[i]);
  263.                 jtp := JTPtr(longint(jt) + sHead^.firstOff);
  264.                 FOR j := 1 TO sHead^.eCount DO BEGIN
  265.                   MakeLoaded(jtp^, seg[i]);
  266.                   jtp := JTPtr(longint(jtp) + sizeof(JTEntry));
  267.                 END;
  268.               END;
  269.  
  270.           END;
  271.  
  272.         BEGIN
  273.  
  274.           { Read the XXCMD in to memory and setup the jump table. }
  275.  
  276.           LoadSegs;
  277.           FixJT;
  278.  
  279.           { Set up a block of data to pass to the XXCMD as the Application Parameters. }
  280.  
  281.           xdata := XXCmdHandle(NewHandle(sizeof(XXCmdBlock)));
  282.           IF MemError <> noErr THEN BEGIN
  283.             FOR i := 1 TO maxRes DO
  284.               IF seg[i] <> NIL THEN BEGIN
  285.                 h := RecoverHandle(seg[i]);
  286.                 DisposHandle(h);
  287.               END;
  288.             paramPtr^.returnValue := PasToZero(paramPtr, 'ERROR: out of memory.');
  289.             exit(XXCMD);
  290.           END;
  291.           WITH xdata^^ DO BEGIN
  292.             message := 0;
  293.             count := 0;
  294.             sig := $87654321; { Signature so that the XXCMD can tell it's not being run from the finder. }
  295.             nextpc := longint(jt) + 2; { The main program starts with the first jump table entry. }
  296.           END;
  297.           { a5 := jt - 32; finder info := a5 + 16 }
  298.           xp := XXCmdHandlePtr(longint(jt) - 32 + 16);
  299.           xp^ := xdata;
  300.  
  301.         END;
  302.  
  303.       BEGIN
  304.  
  305.         { Check that the first parameter is the name of the XXCMD. }
  306.  
  307.         IF paramPtr^.paramCount = 0 THEN BEGIN
  308.           paramPtr^.returnValue := PasToZero(paramPtr, 'ERROR: expected name of XXCMD to execute.');
  309.           exit(XXCMD);
  310.         END;
  311.  
  312.         { Check if the XXCMD is already loaded. }
  313.  
  314.         ZeroToPas(paramPtr, paramPtr^.params[1]^, xname);
  315.         jtname := concat(xname, 'jt');
  316.         h := GetGlobal(paramPtr, jtname);
  317.         IF (h = NIL) | (h^ = NIL) | (h^^ = 0) THEN BEGIN
  318.           IF h <> NIL THEN
  319.             DisposHandle(h);
  320.  
  321.           { Load the XXCMD. }
  322.  
  323.           LoadXXCMD;
  324.  
  325.           { Save a pointer to its jump table in HyperCard. }
  326.  
  327.           LongToStr(paramPtr, longint(jt), tstr);
  328.           h := PasToZero(paramPtr, tstr);
  329.           SetGlobal(paramPtr, jtname, h);
  330.           DisposHandle(h);
  331.  
  332.         END
  333.         ELSE BEGIN
  334.  
  335.           { Get a pointer to the XXCMD's jump table from HyperCard. }
  336.  
  337.           ZeroToPas(paramPtr, h^, tstr);
  338.           DisposHandle(h);
  339.           jt := JTPtr(StrToLong(paramPtr, tstr));
  340.  
  341.         END;
  342.  
  343.         { Execute the XXCMD. }
  344.  
  345.         xp := XXCmdHandlePtr(longint(jt) - 32 + 16);
  346.         xdata := xp^;
  347.         xdata^^.paramPtr := paramPtr;
  348.         Execute(longint(jt) - 32, xdata^^.nextpc);
  349.  
  350.       END;
  351.  
  352. END.
  353.